%% ect_transform.erl
%%   This module contains the entry point for the  parse transformation of ECT. 
%%   It should be invoked via ect.hrl. (Function parse_transform/2.)
%%
%% Copyright (C) 2008, 2009 Gábor Fehér
%%
%% This file is part of ECT.
%% 
%% ECT is free software: you can redistribute it and/or modify
%% it under the terms of the GNU General Public License as published by
%% the Free Software Foundation, either version 3 of the License, or
%% (at your option) any later version.
%% 
%% ECT is distributed in the hope that it will be useful,
%% but WITHOUT ANY WARRANTY; without even the implied warranty of
%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
%% GNU General Public License for more details.
%% 
%% You should have received a copy of the GNU General Public License
%% along with ECT.  If not, see <http://www.gnu.org/licenses/>.
%%
-module(ect_transform).
-export([parse_transform/2]).

-include("common_defs.hrl").

%% This is the record name for all those record definitions that are
%% expanded from ?FIELDS(...) macro expressions.
-define(ECTRANS_MARKER, '_ectrans_marker_slufduksuf_').

%% Function: get_attribute_null(Forms, AttrName)
%% Purpose: gets an attribute from the abstract syntax tree of a module
%% Args: 
%%    Forms: abstract syntax tree of the module
%%    AttrName: an atom that is the name of attribute to find
%% Returns:
%%    {ok, Value} where Value is the value of the attribute, if found
%%    none if the attribute is not found
get_attribute_null([{attribute, _, AttrName, Value}|_], AttrName) ->
    {ok, Value};
get_attribute_null([_|Fs], AttrName) ->
    get_attribute_null(Fs, AttrName);
get_attribute_null([], _) ->
    none.

%% Function: get_attribute_null(Forms, AttrName, Default)
%% Purpose: gets an attribute from the abstract syntax tree of a module
%% Args: 
%%    Forms: abstract syntax tree of the module
%%    AttrName: an atom that is the name of attribute to find
%% Returns:
%%    the value of the attribute, if found
%%    the value of Defualt, if the attribute is not found
get_opt_attribute([{attribute, _, AttrName, Value}|_], AttrName, _) ->
    Value;
get_opt_attribute([_|Fs], AttrName, Default) ->
    get_opt_attribute(Fs, AttrName, Default);
get_opt_attribute([], _, Default) ->
    Default.

%% Function: get_local_fields_av(Forms)
%% Purpose: collect all the fields defined in a class
%% Args: 
%%    Forms: abstract syntax tree of the class to transform
%% Returns:
%%    [{Version, [#class_field{}]}]
%%    A list of field lists, each internal list corresponds to 
%%    one specific version of the class. See common_defs.hrl
%%    for definition of class fields. Warning: walues for 
%%    #class_field.global_pos are not calculated, but set to
%%    undefined.
get_local_fields_av(Forms) ->
    Fields1 = misc:filtermap_list(
        fun ({attribute, _, record, 
                {?ECTRANS_MARKER
                ,[{record_field, _, {atom, _, version}, {integer, _, Version1}}
                 ,{record_field, _, {atom, _, access}, {atom, _, Access}}
                 ,{record_field, _, {atom, _, fields}, {tuple, _, Fields}}
                 ]
                }
             }) ->
                {ok, {Version1, Access, Fields}};
            (_) ->
                false
        end, Forms),
    Fields2 = misc:partition_list(1, Fields1),
    lists:map(
        fun ({Version1, List}) ->
            {Version1, get_local_fields_av0(List, ?FIELD_LOCAL_STARTPOS)}
        end, Fields2).

%% Function: get_local_fields_av0(Fields, Pos1)
%% Purpose: processes the raw field list created in the 
%%          first half of get_local_fields_av/1
%% Args: 
%%    Fields: Raw field list of the form [{Version, Accessor, List}],
%%            where List has the form of [{atom,_,FieldName} | {match,_,{atom,_,FieldName},Value].
%% Returns:
%%    [#class_field{}]
get_local_fields_av0([{_Version, Access, Fields}|Fs], Pos1) ->
    {F1, Pos2} = process_local_fields0(Fields, Access, Pos1),
    F2 = get_local_fields_av0(Fs, Pos2),
    F1++F2;
get_local_fields_av0([], _) ->
    [].
process_local_fields0([{match, _, {atom, _, Field}, Value}|Fields], Access, Pos1) ->
    {Fields2, Pos2} = process_local_fields0(Fields, Access, Pos1+1),
    {[#class_field{name = Field, value = Value, access = Access, local_pos = Pos1}|Fields2], Pos2};
process_local_fields0([{atom, Line, Field}|Fields], Access, Pos1) ->
    {Fields2, Pos2} = process_local_fields0(Fields, Access, Pos1+1),
    {[#class_field{name = Field, value = {atom, Line, undefined}, access = Access, local_pos = Pos1}|Fields2], Pos2};
process_local_fields0([], _, Pos) ->
    {[], Pos}.

%% Function: get_exports(Forms, Tag)
%% Purpose: collects the list of exported functions from an abstract syntax tree.
%% Args: 
%%    Forms: abstract syntax tree of the module to transform
%%    Tag: either 'exports' or 'methods'. Determines which kind of exported functions to collect.
%% Returns:
%%    [{Name, Arity}] list of name and arity pairs of exported functions or methods
%%    (depending on the value of Tag)
get_exports([{attribute, _, Tag, List = [_|_]}|Forms], Tag) ->
    List++get_exports(Forms, Tag);
get_exports([_|Forms], Tag) ->
    get_exports(Forms, Tag);
get_exports([], _) ->
    [].

%% Function: clean_attributes(Forms, ClassInfo)
%% Purpose: removes some ECT-specific attributes from a parse tree
%% Args:
%%   Forms: abstract syntax tree of the module to transform
%%   ClassInfo: ignored
%% Returns:
%%   Forms, but with record definitions and version attribute removed.
clean_attributes([{attribute, _, record, {?ECTRANS_MARKER, _}}|Attrs], ClassInfo) -> % = #compile_info{cctrans = cctrans}) ->
    clean_attributes(Attrs, ClassInfo);
clean_attributes([{attribute, _, version, _}|Attrs], ClassInfo) -> 
    clean_attributes(Attrs, ClassInfo);
clean_attributes([A|Attrs], ClassInfo) ->
    [A|clean_attributes(Attrs, ClassInfo)];
clean_attributes([], _) ->
    [].

%% Function: parse_transform0(Forms1, ThisClass, Options2, CCTrans)
%% Purpose:
%%   -pre-process syntax tree of ECT class modules (and not client modules)
%%   -collect definition information from binaries of other modules
%%   -generates implementation and method proxy modules
%% Args:
%%   Forms1: abstract syntax tree of module to transform
%%   ThisClass: name of the class defined in Forms1
%%   Options2: compiler options, with some default values set
%%   CCTrans: selects the client transformation: cctrans or cctrans0
%% Returns: {Forms3, ClassInfo}
%%   Forms3: abstract syntax tree of the proxy module of the class
%%   ClassInfo: data collected from Forms1 and modules of other classes
%% Side effects:
%%   -Create binary file of implementation module. (class_implN.beam)
%%   -In case of upgrade mode2, create binary file of method proxy module (class_proxyM.beam)
parse_transform0(Forms1, ThisClass, Options2, CCTrans) ->
    Silent = not proplists:get_value(ect_verbose, Options2, false),
    UpgradeMode = 
        case CCTrans of
        cctrans -> 
            misc:get_define_item('ECT_UPGRADE_MODE', Options2, mode1);
        cctrans0 ->
            mode1  % no mode2 support for cctrans0
        end,
    
    {outdir, OutDir2} = proplists:lookup(outdir, Options2),
    
    SuperClass = get_attribute_null(Forms1, superclass),

    Version = get_opt_attribute(Forms1, version, 1),
    LocalFields_AllVersions1 = get_local_fields_av(Forms1),
    LocalFields =
        case lists:keysearch(Version, 1, LocalFields_AllVersions1) of
        false -> [];
        {value, {Version, LF}} -> LF
        end,
    %io:format("LocalFields_AllVersions1 =~p~n", [LocalFields_AllVersions1]),

    Methods = get_exports(Forms1, methods),
    NonVMTExports = get_exports(Forms1, export),

    ImplModule = list_to_atom(atom_to_list(ThisClass)++"_impl"++integer_to_list(Version)),

    LocalClassData = 
        #class_local{
            name = ThisClass,
            version = Version,
            impl_module = ImplModule,
            super_class = SuperClass,
            fields = LocalFields,
            methods = Methods,
            functions = NonVMTExports
        },

    Classes = class_defs:scan(Forms1, {ok, LocalClassData}),
    Def = #class{name = ThisClass, class_types = ClassTypes} = classes:lookup(Classes, ThisClass),
    ClassLevel = tuple_size(ClassTypes),

    LocalFields_AllVersions2 = 
        lists:map(fun ({Version1, Fields}) ->
                     {Version1
                     ,lists:map(fun (F) ->
                                    F#class_field{global_pos = ClassLevel+?FIELD_GLOBAL_STARTPOS-1}
                                end, Fields)
                     }
                  end, LocalFields_AllVersions1),
    
    ClassInfo = #compile_info{
            silent = Silent,
            cctrans = CCTrans,
            upgrade_mode = UpgradeMode,
            out_dir = OutDir2,
            
            local_class_data = LocalClassData,
            fieldmap_av = LocalFields_AllVersions2,
            class_definition = Def,
            classes = Classes
            },

    Forms2 = clean_attributes(Forms1, ClassInfo),

    gen_impl:create_impl(Forms2, ClassInfo, Options2),

    [{Forms3, ThisClass}|MoreProxies] = gen_proxy:create_proxy(ClassInfo),
    lists:map(
        fun ({Forms0, Name}) ->
            modules:compile_forms_to_file(Forms0, Options2, Name, "generated code in "++atom_to_list(Name))
        end,
        MoreProxies),
    
    {Forms3, ClassInfo}.

%% Function: parse_transform(Forms, Options1)
%% Purpose: compiler entry point for parse transformation.
%% Args:
%%   Forms: Abstract Syntax Tree of program
%%   Options: List of options passed to the compiler. Among standard compiler options,
%%            it may contain ECT-specific options.
%% Returns: the result is the transformed abstract syntax tree from Forms, having
%%          plain erlang nodes only.
%% Side effects:
%%   If Forms contains an ECT class, then:
%%   - the resulting syntax tree is the proxy module
%%   - then binary file of the implementation module is created as a side effect
%%   - in case of upgrade mode 2 the binary of the method proxy module is also created
parse_transform(Forms, Options1) ->
    CCTrans = proplists:get_value(cctrans, Options1, cctrans),
    ClassAttr = get_attribute_null(Forms, class),

    OutDir1 = proplists:get_value(outdir, Options1, "./"),
    OutDir2 = 
        case [lists:last(OutDir1)] of
        "/" -> OutDir1;
        _ -> OutDir1++"/"
        end,
    Options2 = [{outdir, OutDir2}|proplists:delete(outdir, Options1)],
    
    try
        case ClassAttr of
            {ok, ThisClass} ->
                try parse_transform0(Forms, ThisClass, Options2, CCTrans) of
                {Forms2, ClassInfo} ->
                    CCTrans:parse_transform_class(Forms2, ClassInfo, Options2)
                catch
                    throw:{implCompileError, Forms2} ->
                        % FIXME
                        Forms2
                end;
            none ->
                CCTrans:parse_transform_module(Forms, Options2, class_defs:scan(Forms, none))
        end
    catch
        throw:{ect_compile_error, {error_type1, ErrorMessage}} ->
            [{error, {none, erl_parse, ErrorMessage}}];
        throw:{ect_runtime_error, ErrorMessage} ->
            [{error, {none, erl_parse, "ect internal error while compiling: "++ErrorMessage}}]
    end.

